BBS in a Box 3/BBS in a box - Trilogy III.iso/Files/Prog/A/Acius09⁄92/CustomOpenDLGƒ/Ext4D_Files_Package.p

Text File | 1992-08-26 | 30.1 KB | 1,083 lines | [TEXT/MPS ]

{===================================================================================================}
{
    Custom Open File Dialog Box external commands for 4th DIMENSION 2.x.x
    by Dominique Hermsdorff
    ©1992 ACI,ACIUS Inc.

    To work with this source code, you have to be familiar with :
        - the File Manager,
        - the List Manager,
        - the Standard File Package.
    See the relevant Inside Macintosh volumes in this purpose and also the Apple Technical Note
    #047- Customizing Standard File.

    About the Custom Open File Dialog Box external commands...

    These commands and the source code are provided to you for your information.
    They are intended to help you in the implementation of your own external commands.
    They are not intended to be used as is, in final applications.

    If you would like to use these commands inside your applications, please use,
    or contact a developer able to use, the source code provided as a template
    to build your own commands.

    Note: ACI and ACIUS Technical Support do not provide support for these external commands.

}
{===================================================================================================}

UNIT EXT4D_FILES_PACKAGE;

{$IFC Undefined THINK_PASCAL }
    {$D- }
    {$R- }
{$ENDC }

INTERFACE

{$IFC Undefined THINK_PASCAL }
    Uses    MemTypes,
                QuickDraw,
                OSIntf,
                OSUtils,
                ToolIntf,
                Lists,
                StandardFile,
                SysEqu,
                Traps,
                Ext4DIntf;
{$ENDC}

{$IFC Undefined THINK_PASCAL }
    {$SETC DebugOn = TRUE }
    {$IFC DebugOn }
        {$D+ }
        {$R+ }
    {$ELSEC }
        {$D- }
        {$R- }
    {$ENDC }
{$ENDC }

{$IFC UNDEFINED THINK_PASCAL }
    {$R- }
{$ENDC }


PROCEDURE CALL_FILES_PACKAGE(ProcNum:LongInt;Params:ParamsTabPtr;Var Data:Handle;Var FuncPtr:Ptr);

IMPLEMENTATION

PROCEDURE FILES_PACKAGE(ProcNum:LongInt;Params:ParamsTabPtr;Var Data:Handle;Var FuncPtr:Ptr);FORWARD;

PROCEDURE CALL_FILES_PACKAGE(ProcNum:LongInt;Params:ParamsTabPtr;Var Data:Handle;Var FuncPtr:Ptr);
BEGIN
    FILES_PACKAGE(ProcNum,Params,Data,FuncPtr);
END; { CALL_FILES_PACKAGE }


CONST        kOpenMFile                    =    1;
                kOpenSFile                    =    2;
                kSetFPos                        =    3;
                kGetEOF                            =    4;
                kGetFileInfo                = 5;

                kMultipleOpenDlgID    =    1;
                kSingleOpenDlgID        =    2;
                    kMessageItem            =    11;
                    kListItem                    =    12;
                    kRemoveItem                =    13;
                    kDoneItem                    = 14;

                HWCfgFlags                     = $B22;

                Enter                                =    $03;
                BackSpace                     =    $08;
                Return                            =    $0D;
                AsciiUp                            =    $1E;
                AsciiDown                        =    $1F;

                CommandKeyCode            =    55;
                ShiftKeyCode                =    56;
                CapsLockKeyCode            =    57;
                OptionKeyCode                = 58;
                ControlKeyCode            =    59;

                OKButton                        =    1;
                DevToolDlgID                =    0;


TYPE        IntegerHandle    =    ^IntegerPtr;

                SFReplyPtr        =    ^SFReply;

                DlgDataHandle    =    ^DlgDataPtr;
                DlgDataPtr        =    ^DlgDataRecord;
                DlgDataRecord    =    RECORD
                                                    SFDlgID                : INTEGER;                {  2 bytes }
                                                    UserReplyPtr    : SFReplyPtr;            {  4 bytes }
                                                    FileList            : ListHandle;            {  4 bytes }
                                                    Array4D                : VarRecPtr;            {  4 bytes }
                                                    FilterProc        : STRING[63];            { 64 bytes }
                                                END;                                                            { 78 bytes in total }

FUNCTION KeyIsDown(WhichKey:INTEGER):BOOLEAN;
VAR    Keyboard:KeyMap;
BEGIN
    GetKeys(KeyBoard);
    KeyIsDown:=KeyBoard[WhichKey];
END; { KeyIsDown }

PROCEDURE    MySetCursor(WhichCursor:INTEGER);
BEGIN
    SetCursor(GetCursor(GetResNum('4BNX','CURS',WhichCursor))^^);
END; { MySetCursor }

PROCEDURE    GetPathName(vRefNum:INTEGER;ParentDirectory:LongInt;FileName:StringPtr);
VAR        ErrCode:INTEGER;
            DirSep:String[1];
            MFSBlock:ParamBlockRec;
            HFSBlock:HParamBlockRec;
            CatBlock:CInfoPBRec;
            ParentName:Str255;
BEGIN
    IF IntegerPtr($3F6)^> 0 THEN
    BEGIN
        ParentName:='';
        WITH HFSBlock DO
        BEGIN
            ioCompletion:=NIL;
            ioNamePtr:=@ParentName;
            ioVolIndex:=0;
            ioVRefNum:=vRefNum;
        END; { With HFSBlock Do }
        ErrCode:=PBHGetVInfo(@HFSBlock,FALSE);
        IF ErrCode=NoErr THEN
        BEGIN
            IF BTst(LongInt(IntegerPtr(HWCfgFlags)^),9) THEN DirSep:='/' ELSE DirSep:=':';
            IF HFSBlock.IOVSigWord=$D2D7 THEN FileName^:=CONCAT(ParentName,DirSep,FileName^)
            ELSE
            BEGIN
                CatBlock.ioDrParID:=ParentDirectory;
                REPEAT
                    ParentName:='';
                    WITH CatBlock DO
                    BEGIN
                        ioCompletion:=NIL;
                        ioNamePtr:=@ParentName;
                        ioVRefNum:=vRefNum;
                        ioFDirIndex:=-1;
                        ioDirID:=0;
                        ioDrDirID:=ioDrParID;
                    END;
                    ErrCode:=PBGetCatInfo(@CatBlock,FALSE);
                    IF ErrCode=NoErr THEN
                    BEGIN
                        IF Length(FileName^)+Length(ParentName)<255 THEN FileName^:=CONCAT(ParentName,DirSep,FileName^)
                        ELSE
                        BEGIN
                            FileName^:='';
                            ErrCode:=1;
                        END;
                    END
                    ELSE FileName^:='';
                UNTIL (CatBlock.ioDrDirID=fsRtDirID) | (ErrCode<>NoErr);
            END;
        END
        ELSE FileName^:='';
    END
    ELSE
    BEGIN
        ParentName:='';
        WITH MFSBlock DO
        BEGIN
            ioCompletion:=NIL;
            ioNamePtr:=@ParentName;
            ioVolIndex:=0;
            ioVRefNum:=vRefNum;
        END;
        ErrCode:=PBGetVInfo(@MFSBlock,FALSE);
        IF ErrCode=NoErr THEN FileName^:=Concat(ParentName,DirSep,FileName^) ELSE FileName^:='';
    END;
END; { GetPathName }

PROCEDURE DisposeExpression(Expression:VarRecPtr);
BEGIN
    WITH Expression^ DO
    BEGIN
        CASE VarKind OF
            Alpha    : IF CC<>NIL THEN DisposHandle(Handle(CC));
            Pict    : IF PP<>NIL THEN DisposHandle(Handle(PP));
        END;
    END;
END; { DisposeExpression }

FUNCTION Call4DLongIntFunction(FunctionText:Handle):LongInt;
VAR    CurPort:GrafPtr;
        MyWind:WindowPtr;
        Blk4D:ParmBlock;
        FunctionResult:VarRec;
BEGIN
    Call4DLongIntFunction:=0;
    Blk4D.HH:=FunctionText;                                                        { Pass the text to be executed }
    FunctionResult.VarKind:=Nothing;                                    { Set the function result to undefined }
    Blk4D.Result1:=ORD4(@FunctionResult);                            { Pass the function result record }
    MyWind:=FrontWindow;                                                            { See note below }
    GetPort(CurPort);                                                                { See note below }
    Call4D(EX_Execute_function,Blk4D);                                { Call 4D }
    SetPort(CurPort);                                                                    { See note below }
    IF MyWind<>NIL THEN SelectWindow(MyWind);                    { See note below }
    DisposHandle(FunctionText);                                                { We do not need the text anymore }
    WITH FunctionResult DO
        IF (VarKind=Long4D) THEN                                                { Did the 4D function return a LongInt value? }
            Call4DLongIntFunction:=LValue;                                { If so, get it }
    DisposeExpression(@FunctionResult);                                { Necessary if the function mistakely returns
                                                                                                            a text or a picture }
    { IMPORTANT NOTE
        --------------
        We call back 4th DIMENSION from the file filtering function, which is itself called
        by the Standard File Package. Although it is not a good idea, we may call the TRACE window
        or display a window in the 4th DIMENSION function
        We do not have any way to forbide such a command from our package.
        In such a case, 4th DIMENSION does not know anything about our dialog. In other words,
        4th DIMENSION will not save and restore the current GrafPort. This is why we do it by ourselves.
        We call SelectWindow in order to solve the problem of the TRACE window which may appear
        above our SFP dialog. }

END; { Call4DLongIntFunction }

PROCEDURE ClearArray(VAR anArray:VarRec);
VAR    z:LongInt;
        h:Handle;
        s:StringPtr;
BEGIN
    WITH anArray DO
    BEGIN
        IF NbElem>0 THEN
        BEGIN
            IF VarKind=TabAlpha THEN
            BEGIN
                IF TabAlphaH<>NIL THEN
                BEGIN
                    FOR z:=0 TO NbElem DO
                    BEGIN
                        h:=Handle(TabAlphaH^^[z].CC);
                        IF h<>NIL THEN DisposHandle(h);
                    END;
                END;
            END
            ELSE
            BEGIN
                IF VarKind=TabPict THEN
                BEGIN
                    FOR z:=0 TO NbElem DO
                    BEGIN
                        h:=Handle(TabPictH^^[z]);
                        IF h<>NIL THEN DisposHandle(h);
                    END;
                END;
            END;
            CASE VarKind OF
                TabInt            : z:=SizeOf(Integer);
                TabLong            : z:=SizeOf(LongInt);
                TabNum            : z:=SizeOf(Extended);
                TabAlpha        :    z:=SizeOf(TE4D);
                TabPict            :    z:=SizeOf(PicHandle);
                TabDate            : z:=SizeOf(Date4D);
                TabBool            : z:=2;
                TabStrFix        : BEGIN
                                                z:=ORD4(TabFixH^^.LenFix);
                                                IF ODD(z) THEN z:=z+1;
                                                z:=z+2;
                                            END;
            END;
            IF TabIntH<>NIL THEN SetHandleSize(Handle(TabIntH),z);
            NbElem:=0;
            CurSel:=0;
            CASE VarKind OF
                TabBool,
                TabInt            : TabIntH^^[0]:=0;
                TabLong            : TabLongH^^[0]:=0;
                TabNum            : TabNumH^^[0]:=0;
                TabAlpha        :    WITH TabAlphaH^^[0] DO
                                            BEGIN
                                                Len:=0;
                                                CC:=NIL;
                                            END;
                TabPict            :    TabPictH^^[0]:=NIL;
                TabDate            : WITH TabDateH^^[0] DO
                                            BEGIN
                                                Day:=0;
                                                Month:=0;
                                                Year:=0;
                                            END;
                TabStrFix        : BEGIN
                                                s:=StringPtr(ORD4(TabFixH^)+2);
                                                s^:='';
                                            END;
            END;
        END;
    END;
END; { ClearArray }

FUNCTION ResizeArray(VAR anArray:VarRec;Nb:LongInt):OSErr;
VAR n:INTEGER;
        z:LongInt;
        h:Handle;
BEGIN
    ResizeArray:=NoErr;
    ClearArray(anArray);
    WITH anArray DO
    BEGIN
        Nb:=Nb+1;
        CASE VarKind OF
            TabInt            : z:=Nb*SizeOf(INTEGER);
            TabLong            : z:=Nb*SizeOf(LongInt);
            TabNum            : z:=Nb*SizeOf(Extended);
            TabAlpha        :    z:=Nb*SizeOf(TE4D);
            TabPict            :    z:=Nb*SizeOf(PicHandle);
            TabDate            : z:=Nb*SizeOf(Date4D);
            TabBool            : z:=2+(Nb DIV 8);
            TabStrFix        : BEGIN
                                            n:=TabFixH^^.LenFix;
                                            z:=ORD4(n);
                                            IF ODD(z) THEN z:=z+1;
                                            z:=2+(Nb*z);
                                        END;
        END;
        Nb:=Nb-1;
        h:=NewHandleClear(z);
        IF h<>NIL THEN
        BEGIN
            IF TabIntH<>NIL THEN DisposHandle(Handle(TabIntH));
            TabIntH:=TabOfIntHandle(h);
            NbElem:=Nb;
            CurSel:=0;
            IF VarKind=TabStrFix THEN IntegerHandle(TabFixH)^^:=n;
        END
        ELSE ResizeArray:=MemFullErr;
    END;
END; { ResizeArray }

FUNCTION StringArrayFixLen(anArray:VarRecPtr):LongInt;
VAR    z:LongInt;
BEGIN
    WITH anArray^ DO
    BEGIN
        IF VarKind=TabStrFix THEN
        BEGIN
            z:=ORD4(TabFixH^^.LenFix);
            IF ODD(z) THEN z:=z+1;
        END
        ELSE z:=0;
    END;
    StringArrayFixLen:=z;
END; { StringArrayFixLen }

FUNCTION AddStringElement(StrValue:StringPtr;Element:LongInt;anArray:VarRecPtr):BOOLEAN;
VAR    z,n:LongInt;
        h:Handle;
BEGIN
    AddStringElement:=TRUE;
    WITH anArray^ DO
    BEGIN
        z:=ORD4(Length(StrValue^));
        IF VarKind=TabAlpha THEN
        BEGIN
            h:=NewHandle(z);
            IF h<>NIL THEN
            BEGIN
                IF z>0 THEN BlockMove(Ptr(ORD4(StrValue)+1),Ptr(h^),z);
                WITH TabAlphaH^^[Element] DO
                BEGIN
                    CC:=CharsHandle(h);
                    Len:=ORD(z);
                END;
            END
            ELSE AddStringElement:=FALSE;
        END
        ELSE
        BEGIN
            IF z>0 THEN
            BEGIN
                n:=StringArrayFixLen(anArray);
                z:=z+1;
                IF z>n THEN z:=n;
                BlockMove(Ptr(StrValue),Ptr(ORD4(TabFixH^)+2+(Element*n)),z);
            END;
        END;
    END;
END; { AddStringElement }

PROCEDURE SetDocumentVar(FileName:StringPtr);
VAR Error:INTEGER;
    Blk4D:ParmBlock;
    DocVar:VarRec;
BEGIN
  WITH Blk4D DO
    BEGIN
        Name:='Document';
        HH:=Handle(@DocVar);
    END;
    Call4D(EX_GET_VARIABLE,Blk4D);
    IF Blk4D.Error=NoErr THEN
    BEGIN
      Error:=NoErr;
        WITH DocVar DO
        BEGIN
            CASE VarKind OF
              Nothing,
                Alpha        :    BEGIN
                                    Len:=Length(FileName^);
                                        IF (VarKind=Nothing) THEN
                                        BEGIN
                                          CC:=CharsHandle(NewHandle(ORD4(Len)));
                                            IF CC=NIL THEN Error:=MemFullErr;
                                            VarKind:=Alpha;
                                        END
                                        ELSE
                                        BEGIN
                                            Blk4D.ClearOldVariable:=FALSE;
                                            IF CC=NIL THEN
                                            BEGIN
                                                CC:=CharsHandle(NewHandle(ORD4(Len)));
                                              IF CC=NIL THEN Error:=MemFullErr;
                                            END
                                            ELSE
                                            BEGIN
                                                SetHandleSize(Handle(CC),ORD4(Len));
                                                Error:=MemError;
                                            END;
                                        END;
                                        IF (Error=NoErr) & (Len>0) THEN BlockMove(Ptr(ORD4(FileName)+1),Ptr(CC^),ORD4(Len));
                               END;
              StrFix    : BEGIN
                                      SLen:=Length(FileName^);
                                        SValue:=FileName^;
                            END;
              OTHERWISE Error:=-1;
            END;
        END;
        IF Error=NoErr THEN Call4D(EX_PUT_VARIABLE,Blk4D);
    END;
END; { SetDocumentVar }

PROCEDURE AddStringToText(Str:StringPtr;Data:Handle);
VAR    StrLen,DataLen:LongInt;
BEGIN
    StrLen:=ORD4(Length(Str^));
    IF StrLen>0 THEN
    BEGIN
        DataLen:=GetHandleSize(Data);
        SetHandleSize(Data,DataLen+StrLen);
        IF MemError=NoErr THEN BlockMove(Ptr(ORD4(Str)+1),Ptr(ORD4(Data^)+DataLen),StrLen);
    END;
END; { AddStringToText }

{$I    Ext4D_DevTools_Dlg.p }

PROCEDURE    MySetUItem(MyDlg:DialogPtr;MyItem:INTEGER;ItemProc:ProcPtr);
VAR    Kind:INTEGER;
        Content:Handle;
        ItemRect:Rect;
BEGIN
    GetDItem(MyDlg,MyItem,Kind,Content,ItemRect);
    SetDItem(MyDlg,MyItem,UserItem,Handle(ItemProc),ItemRect);
END; { MySetUItem }

PROCEDURE    HiliteCtlItem(MyDlg:DialogPtr;MyItem:INTEGER;Value:INTEGER);
VAR    Kind:INTEGER;
        Content:Handle;
        ItemRect:Rect;
BEGIN
    GetDItem(MyDlg,MyItem,Kind,Content,ItemRect);
    HiliteControl(ControlHandle(Content),Value);
END; { HiliteCtlItem }

PROCEDURE HiliteDlgButton(MyDlg:DialogPtr;MyItem:INTEGER);
VAR    finalTicks:LongInt;
BEGIN
    HiliteCtlItem(MyDlg,MyItem,1);
    Delay(8,finalTicks);
    HiliteCtlItem(MyDlg,MyItem,0);
END; { HiliteDlgButton }

FUNCTION LNbOfRows(List:ListHandle):INTEGER;
BEGIN
    LNbOfRows:=List^^.DataBounds.Bottom;
END;

PROCEDURE LGetString(List:ListHandle;Row,Column:INTEGER;Value:StringPtr);
VAR    Len:INTEGER;
        Data:Handle;
        TargetCell:Point;
BEGIN
    Value^:='';
    Data:=NewHandle(255);
    IF Data<>NIl THEN
    BEGIN
        HLock(Data);
        Len:=255;
        TargetCell.H:=Column;
        TargetCell.V:=Row;
        LGetCell(Ptr(Data^),Len,TargetCell,List);
        IF Len>0 THEN BlockMove(Ptr(Data^),Ptr(ORD4(Value)+1),ORD4(Len));
        Value^[0]:=Chr(Len);
        HUnLock(Data);
        DisposHandle(Data);
    END;
END; { LGetString }

FUNCTION LGetInteger(List:ListHandle;Row,Column:INTEGER):INTEGER;
VAR    Len,Value:INTEGER;
        TargetCell:Point;
BEGIN
    Value:=0;
    Len:=2;
    TargetCell.H:=Column;
    TargetCell.V:=Row;
    LGetCell(Ptr(@Value),Len,TargetCell,List);
    LGetInteger:=Value;
END; { LGetInteger }

FUNCTION LGetLongInt(List:ListHandle;Row,Column:INTEGER):LongInt;
VAR    Len:INTEGER;
        Value:LongInt;
        TargetCell:Point;
BEGIN
    Value:=0;
    Len:=4;
    TargetCell.H:=Column;
    TargetCell.V:=Row;
    LGetCell(Ptr(@Value),Len,TargetCell,List);
    LGetLongInt:=Value;
END; { LGetLongInt }

PROCEDURE LPutString(List:ListHandle;Row,Column:INTEGER;Value:StringPtr);
VAR    Len:INTEGER;
        Data:Handle;
        TargetCell:Point;
BEGIN
    Len:=Length(Value^);
    IF Len>0 THEN
    BEGIN
        Data:=NewHandle(Len);
        IF Data<>NIl THEN
        BEGIN
            HLock(Data);
            BlockMove(Ptr(ORD4(Value)+1),Ptr(Data^),ORD4(Len));
            TargetCell.H:=Column;
            TargetCell.V:=Row;
            LSetCell(Ptr(Data^),Len,TargetCell,List);
            HUnLock(Data);
            DisposHandle(Data);
        END;
    END;
END; { LPutString }

PROCEDURE LPutInteger(List:ListHandle;Row,Column:INTEGER;Value:INTEGER);
VAR    TargetCell:Point;
BEGIN
    TargetCell.H:=Column;
    TargetCell.V:=Row;
    LSetCell(Ptr(@Value),2,TargetCell,List);
END; { LPutInteger }

PROCEDURE LPutLongInt(List:ListHandle;Row,Column:INTEGER;Value:LongInt);
VAR    TargetCell:Point;
BEGIN
    TargetCell.H:=Column;
    TargetCell.V:=Row;
    LSetCell(Ptr(@Value),4,TargetCell,List);
END; { LPutInteger }

FUNCTION LSearchFile(FileName:StringPtr;
                                         vRefNum:INTEGER;
                                         DirID:LongInt;
                                         List:ListHandle;VAR ExactMatch:INTEGER):INTEGER;
VAR    Count,Comparison,Where,NbOfRows:INTEGER;
        Str:Str255;
BEGIN
    ExactMatch:=-1;
    Where:=32000;
    NbOfRows:=LNbOfRows(List);
    IF NbOfRows>0 THEN
    BEGIN
        FOR Count:=0 TO NbOfRows DO
        BEGIN
            LGetString(List,Count,0,@Str);
            Comparison:=RelString(FileName^,Str,FALSE,TRUE);
            IF Comparison<=0 THEN
            BEGIN
                IF Where<>32000 THEN Where:=Count;
                IF Comparison=0 THEN
                    IF LGetInteger(List,Count,1)=vRefNum THEN
                        IF LGetLongInt(List,Count,2)=DirID THEN ExactMatch:=Count;
            END;
        END;
    END;
    LSearchFile:=Where;
END; { LSearchFile }

PROCEDURE LDeleteSelection(List:ListHandle);
VAR    NbOfRows:INTEGER;
        aCell:Point;
BEGIN
    aCell.H:=0;
    aCell.V:=0;
    IF LGetSelect(TRUE,aCell,List) THEN
    BEGIN
        LDelRow(1,aCell.V,List);
        NbOfRows:=LNbOfRows(List);
        IF NbOfRows>0 THEN
        BEGIN
            IF aCell.V>=NbOfRows THEN aCell.V:=NbOfRows-1;
            LSetSelect(TRUE,aCell,List);
        END;
    END;
END; { LDeleteSelection }

FUNCTION LGetSelection(List:ListHandle):INTEGER;
VAR    aCell:Point;
BEGIN
    aCell.H:=0;
    aCell.V:=0;
    IF LGetSelect(TRUE,aCell,List) THEN LGetSelection:=aCell.V
    ELSE LGetSelection:=-1;
END; { LGetSelection }

PROCEDURE LSetSelection(List:ListHandle;Row,Column:INTEGER);
VAR aCell:Point;
BEGIN
    aCell.H:=0;
    aCell.V:=0;
    IF LGetSelect(TRUE,aCell,List) THEN
                                        LSetSelect(FALSE,aCell,List);
    aCell.H:=Column;
    aCell.V:=Row;
    LSetSelect(TRUE,aCell,List);
    LAutoScroll(List);
END; { LSetSelection }

FUNCTION GetDlgData:DlgDataHandle;

    { We need to share some data between the SFP Dialog Hook, the File Filtering Function and the
        procedure that actually calls the SFP dialog.
        Because we do not have global variables we use a resource as a record.
        We cannot access to this resource by using its resource ID, so we use its name. }

BEGIN
    GetDlgData:=DlgDataHandle(GetNamedResource('DATA','4DPX/SFPGetFile/23001'));
END; { GetDlgData }

PROCEDURE DrawListItem(MyDlg:DialogPtr;MyItem:INTEGER);
VAR    ItemRect:Rect;
        FileList:ListHandle;
        UpdateRgn:RgnHandle;
BEGIN
    FileList:=GetDlgData^^.FileList;
    IF FileList<>NIL THEN
    BEGIN
        UpdateRgn:=NewRgn;
        IF UpdateRgn<>NIL THEN
        BEGIN
            CopyRgn(MyDlg^.VisRgn,UpdateRgn);
            LUpdate(UpdateRgn,FileList);
            DisposeRgn(UpdateRgn);
        END;
        GetItemRect(MyDlg,MyItem,ItemRect);
        FrameRect(ItemRect);
    END;
END; { DrawListItem }

FUNCTION OpenDlgHook(MyItem:INTEGER;MyDlg:DialogPtr):INTEGER;
CONST    StayInSFDlg        =    0;
            RedrawSFList    =    101;
VAR    vRefNum,Len,Count:INTEGER;
        DirID:LongInt;
        aCell:Point;
        DlgData:DlgDataHandle;
        FileList:ListHandle;
        ItemRect,BoundsRect:Rect;
        Array4D:VarRecPtr;
        FileName:Str255;
BEGIN
    IF MyItem=sfHookFirstCall THEN                                                        { Is it the Initialization phase ? }
    BEGIN
        DlgData:=GetDlgData;                                                                        { Get our resource }
        IF DlgData^^.SFDlgID=kOpenMFile THEN                                        { Is it the multiple open dialog? }
        BEGIN
            GetItemRect(MyDlg,kListItem,ItemRect);                                { Get the rectangle of the item }
            InsetRect(ItemRect,1,1);                                                            { Make room for its frame }
            WITH ItemRect DO
            BEGIN
                Right:=Right-15;                                                                        { Make room for the vertical scroll bar }
                aCell.H:=Right-Left;                                                                { Cell width = List width }
                aCell.V:=16;                                                                                { Cell height = 16 pt for Chicago font }
            END;
            SetRect(BoundsRect,0,0,3,0);                                                    { 0 row, 3 columns }
            FileList:=LNew(ItemRect,BoundsRect,aCell,0,
                                         MyDlg,TRUE,FALSE,FALSE,TRUE);                    { Create the list }
            IF FileList<>NIL THEN                                                                    { Was it possible? }
            BEGIN
                WITH FileList^^ DO
                BEGIN
                    SelFlags:=lOnlyOne;                                                                { We can select only one cell at a time }
                    ListFlags:=lDoVAutoscroll;                                                { Only automatic vertical scrolling }
                END;
                DlgData^^.FileList:=FileList;                                                { Save the handle }
            END;
            MySetUItem(MyDlg,kListItem,@DrawListItem);                        { Set up our user proc. }
            HiliteCtlItem(MyDlg,kRemoveItem,255);                                    { Remove is initially dimmed }
            HiliteCtlItem(MyDlg,kDoneItem,255);                                        { Done is initially dimmed }
        END;
    END
    ELSE
    BEGIN
        IF ((MyItem>0) & (MyItem<100)) | (MyItem>=$1000) THEN    { Avoid the fake items }
        BEGIN
            DlgData:=GetDlgData;                                                                    { Get our resource }
            If DlgData^^.SFDlgID=kOpenMFile THEN                                    { Is it the multiple open dialog? }
            BEGIN
                FileList:=DlgData^^.FileList;
                IF FileList<>NIL THEN                                                                { Does the list exist? }
                BEGIN
                    IF MyItem>=$1000 THEN                                                            { Is it a keyboard event? }
                    BEGIN
                        Len:=LNbOfRows(FileList);                                                { Number of files in our list }
                        Count:=LGetSelection(FileList);                                    { Selected file, if any }
                        IF (MyItem-$1000)=BackSpace THEN                                { Delete key? }
                        BEGIN
                            IF Count>=0 THEN                                                            { Is there a file selected? }
                            BEGIN
                                MyItem:=kRemoveItem;                                                { If so, execute the code associated
                                                                                                                            with the button Remove }
                                HiliteDlgButton(MyDlg,kRemoveItem);                    { Just for cosmetic purpose }
                            END;
                        END
                        ELSE
                        BEGIN
                            IF KeyIsDown(OptionKeyCode) THEN                            { Is the Option key pressed? }
                            BEGIN
                                IF Len>0 THEN                                                                { Is our list empty? }
                                BEGIN
                                    Len:=Len-1;                                                                { If not, test if we pressed the
                                                                                                                            Up or the Down arrow key }
                                    IF Count>=0 THEN
                                    BEGIN
                                        CASE MyItem-$1000 OF
                                            AsciiUp:
                                            BEGIN
                                                Count:=Count-1;
                                                IF Count<0 THEN Count:=Len;
                                                MyItem:=kListItem;
                                            END;
                                            AsciiDown:
                                            BEGIN
                                                Count:=Count+1;
                                                IF Count>Len THEN Count:=0;
                                                MyItem:=kListItem;
                                            END;
                                        END;
                                        IF MyItem=kListItem THEN                                { It was one of these two keys }
                                        BEGIN
                                            LSetSelection(FileList,Count,0);            { Move the selection }
                                            MyItem:=0;                                                        { No more thing to do }
                                        END;
                                    END; { Empty selection? }
                                END; { Empty list? }
                            END; { OptionKey? }
                        END; { Backspace ? }
                    END; { IF MyItem>=$1000 THEN }
                    IF MyItem<$1000 THEN
                    BEGIN
                        CASE MyItem OF
                            GetOpen:                                                                            { We clicked on the Add button }
                            BEGIN
                                FileName:=DlgData^^.UserReplyPtr^.FName;        { Get the file name from the reply }
                                vRefNum:=-IntegerPtr(SFSaveDisk)^;                    { Get the volume reference number }
                                DirID:=LongIntPtr(CurDirStore)^;                        { Get the parent directory ID }
                                Count:=LSearchFile(@FileName,
                                                                     vRefNum,
                                                                     DirID,
                                                                     FileList,Len);                        { Check if the file is already selected }
                                IF Len>=0 THEN
                                    LSetSelection(FileList,Len,0)                          { If so, just select it }
                                ELSE
                                BEGIN
                                    Count:=LAddRow(1,Count,FileList);                    { Insert a new row }
                                    IF Count>=0 THEN
                                    BEGIN
                                        LPutString(FileList,Count,0,@FileName);    { Save the file name }
                                        LPutInteger(FileList,Count,1,vRefNum);    { Save the volume reference number }
                                        LPutLongInt(FileList,Count,2,DirID);        { Save the parent directory ID }
                                        LSetSelection(FileList,Count,0);                { Select the new line }
                                    END;
                                END;
                            END; { GetOpen }

                            GetCancel,kDoneItem:                                                    { We leave the dialog }
                            BEGIN
                                Array4D:=DlgData^^.Array4D;                                    { Get a pointer to the 4D array }
                                ClearArray(Array4D^);                                                { In any case, we clear the 4D array }
                                IF MyItem=kDoneItem THEN                                        { We clicked on the Done button }
                                BEGIN
                                    IF Array4D^.VarKind
                                                        IN [TabAlpha,TabStrFix] THEN        { If the type of the array is valid }
                                    BEGIN
                                        Len:=LNbOfRows(FileList);
                                        IF Len>0 THEN                                                      { If there is at least one file }
                                        BEGIN
                                            IF ResizeArray(Array4D^,
                                                                ORD4(Len))=NoErr THEN              { Set the new size of the array }
                                            BEGIN
                                                FOR Count:=0 TO Len-1 DO                        { For each row:
                                                                                                                            - Get the file name,
                                                                                                                            - The volume reference number,
                                                                                                                            - The parent directory ID,
                                                                                                                            - Calculate the path name,
                                                                                                                            - Insert this latter in the array. }
                                                BEGIN
                                                    LGetString(FileList,Count,0,@FileName);
                                                    GetPathName(LGetInteger(FileList,Count,1),
                                                                            LGetLongInt(FileList,Count,2),@FileName);
                                                    IF NOT(AddStringElement(@FileName,1+ORD4(Count),Array4D)) THEN LEAVE;
                                                END;
                                            END;
                                        END;
                                    END;
                                END;
                                LDispose(FileList);                                                    { We do not need the list anymore }
                                DlgData^^.FileList:=NIL;
                            END; { GetCancel,kDoneItem }
                            kListItem:                                                                        { We clicked on our list }
                            BEGIN
                                GetMouse(aCell);                                                        { Where is the mouse? }
                                IF LClick(aCell,0,FileList) THEN                        { Is it a double-click? }
                                BEGIN
                                    HiliteDlgButton(MyDlg,kRemoveItem);                { Just for cosmetic purpose }
                                    LDeleteSelection(FileList);                                { If so, remove the file from the list }
                                END;
                            END; { kListItem }
                            kRemoveItem:                                                                    { We clicked on the Remove button }
                                LDeleteSelection(FileList);                                    { Remove the file from the list }
                        END; { CASE MyItem OF }
                    END; { Keyboard event? }
                    IF LNbOfRows(FileList)>0 THEN
                        Count:=0 ELSE Count:=255;
                    HiliteCtlItem(MyDlg,kDoneItem,Count);                            { Update the state of the button Done }
                    IF LGetSelection(FileList)>=0 THEN
                        Count:=0 ELSE Count:=255;
                    HiliteCtlItem(MyDlg,kRemoveItem,Count);                        { Update the state of the button Remove }
                END; { IF FileList<>NIL THEN }

                CASE MyItem OF
                    GetOpen            : MyItem:=StayInSFDlg;                                { We stay in the dialog }
                    kDoneItem        :    MyItem:=GetCancel;                                    { We leave the dialog }
                END; { CASE MyItem OF }

            END; { If DlgData^^.DlgID=kOpenMFile THEN }
        END; { IF (MyItem>0) & (MyItem<100) THEN }
    END;
    OpenDlgHook:=MyItem;                                                                            { Do not forget! }
END; { OpenDlgHook }

FUNCTION OpenFileFilter(FileBlk:HParmBlkPtr):BOOLEAN;
VAR    FunctionText:Handle;
        Str:Str255;
BEGIN
    OpenFileFilter:=TRUE;
    FunctionText:=NewHandle(0);
    IF FunctionText<>NIL THEN
    BEGIN
        Str:=FileBlk^.ioNamePtr^;
        GetPathName(-IntegerPtr(SFSaveDisk)^,LongIntPtr(CurDirStore)^,@Str);
        SetDocumentVar(@Str);

        Str:=GetDlgData^^.FilterProc;
        AddStringToText(@Str,FunctionText);
        OpenFileFilter:=NOT(Call4DLongIntFunction(FunctionText)>0);

        { IMPORTANT NOTE
            --------------
            Calling back 4th DIMENSION from the File Filtering Function may introduce some effects:
            - Displaying the list of the files will be slow down. It will take as long as the time
            to execute the 4th DIMENSION function for each file to be displayed. This factor is important
            especially if you run an interpreted database.
            - If you trace the 4th DIMENSION function, remember that the 4D code is executing outside any
            regular execution cycle. Subsequently, 4th DIMENSION will not close the Trace window.
        }

    END;
END; { OpenFileFilter }


PROCEDURE FILES_PACKAGE;

    PROCEDURE    CustSFGetFile(FileName:Ptr;DlgID,L,T:INTEGER;FilterProcName,Message:StringPtr);
    VAR    Where:Point;
            CurPort:GrafPtr;
            TypeList: SFTypeList;
            UserReply:SFReply;
            DlgData:DlgDataHandle;
    BEGIN
        DlgData:=GetDlgData;
        IF DlgData<>NIL THEN
        BEGIN
            HNoPurge(Handle(DlgData));
            WITH DlgData^^ DO
            BEGIN
                SFDlgID:=DlgID;
                UserReplyPtr:=SFReplyPtr(@UserReply);
                FileList:=NIL;
                IF DlgID=kOpenMFile THEN Array4D:=VarRecPtr(FileName) ELSE Array4D:=NIL;
                IF Length(FilterProcName^)>63 THEN FilterProcName^[0]:=Chr(63);
                FilterProc:=FilterProcName^;
            END;
            Where.H:=L;
            Where.V:=T;
            GetPort(CurPort);
            ParamText(Message^,'','','');
            SFPGetFile(Where,
                                 '',
                                 @OpenFileFilter,
                                 -1,TypeList,
                                 @OpenDlgHook,
                                 UserReply,
                                 GetResNum('4BNX','DLOG',DlgID),
                                 NIL);
            SetPort(CurPort);
            IF DlgID=kOpenSFile THEN
            BEGIN
                WITH UserReply DO
                BEGIN
                    IF Good THEN
                    BEGIN
                        StringPtr(FileName)^:=FName;
                        GetPathName(vRefNum,LongIntPtr(CurDirStore)^,StringPtr(FileName));
                    END
                    ELSE StringPtr(FileName)^:='';
                END; { WITH UserReply DO }
            END; { IF DlgID=kOpenSFile THEN }
            HPurge(Handle(DlgData));
        END; { IF DlgData<>NIL THEN }
    END; { CustSFGetFile }

    PROCEDURE DoGetFileInfo;
    VAR    Count:INTEGER;
            ParamBlk:ParamBlockRec;
            FileName:Str255;

        PROCEDURE DoSecs2Date(Secs:LongInt;VAR aDate:Date4D;VAR aTime:LongInt);
        VAR    aMacDate:DateTimeRec;
        BEGIN
            Secs2Date(Secs,aMacDate);
            WITH aMacDate DO
            BEGIN
                aDate.Year:=Year;
                aDate.Month:=Month;
                aDate.Day:=Day;
                aTime:=ORD4(Hour)*3600+ORD4(Minute)*60+ORD4(Second);
            END;
        END; { DoSecs2Date }

    BEGIN
        FileName:=StringPtr(Params^[1])^;
        WITH ParamBlk DO
        BEGIN
            ioCompletion:=NIL;
            ioNamePtr:=@FileName;
            ioVRefNum:=0;
            ioFVersNum:=0;
            ioFDirIndex:=-1;
        END;
        IF PBGetFInfo(@ParamBlk,FALSE)=NoErr THEN
        BEGIN
            WITH ParamBlk DO
            BEGIN
                FOR Count:=1 TO 4 DO
                BEGIN
                    StringPtr(Params^[2])^[Count]:=ioFlFndrInfo.fdType[Count];
                    StringPtr(Params^[3])^[Count]:=ioFlFndrInfo.fdCreator[Count];
                END;
                StringPtr(Params^[2])^[0]:=Chr(4);
                StringPtr(Params^[3])^[0]:=Chr(4);
                LongIntPtr(Params^[4])^:=ioFlLgLen;
                LongIntPtr(Params^[5])^:=ioFlPyLen;
                LongIntPtr(Params^[6])^:=ioFlRLgLen;
                LongIntPtr(Params^[7])^:=ioFlRPyLen;
                DoSecs2Date(ioFlCrDat,Date4DPtr(Params^[8])^,LongIntPtr(Params^[10])^);
                DoSecs2Date(ioFlMdDat,Date4DPtr(Params^[9])^,LongIntPtr(Params^[11])^);
            END;
        END
        ELSE
        BEGIN
            FOR Count:=2 TO 3 DO StringPtr(Params^[Count])^:='';
            StringPtr(Params^[3])^:='';
            FOR Count:=4 TO 7 DO LongIntPtr(Params^[Count])^:=0;
            FOR Count:=10 TO 11 DO LongIntPtr(Params^[Count])^:=0;
            FOR Count:=8 TO 9 DO
            BEGIN
                WITH Date4DPtr(Params^[Count])^ DO
                BEGIN
                    Year:=0;
                    Month:=0;
                    Day:=0;
                END;
            END;
        END;
    END; { DoGetFileInfo }

BEGIN { FILES_PACKAGE }
    IF ProcNum>0 THEN
    BEGIN
        CASE ORD(ProcNum) OF

                { OpenMFile(FileNames;Left;Top;FilterProc;Message)
                    OpenMFile(Array;Number;Number;String;String)
                    OpenMFile(&S;&L;&L;&S;&S)

                    OpenSFile(FileName;Left;Top;FilterProc;Message)
                    OpenSFile(String;Number;Number;String;String)
                    OpenSFile(&S;&L;&L;&S;&S) }

            kOpenMFile,kOpenSFile:
                CustSFGetFile(Ptr(Params^[1]),
                                            ORD(ProcNum),
                                            IntegerPtr(Params^[2])^,
                                            IntegerPtr(Params^[3])^,
                                            StringPtr(Params^[4]),
                                            StringPtr(Params^[5]));

                { SetFPos(Document RefNum;MarkerPosition) -> OS Error
                    SetFPos(Number;Number) -> Number
                    SetFPos(&L;&L):L }

            kSETFPOS:
                FuncPtr:=Ptr(ORD4(SetFPos(ORD(LongIntPtr(Params^[1])^),
                                                                                fsFromStart,LongIntPtr(Params^[2])^)));

                { GetEOF(Document RefNum;Size of the document in bytes) -> OS Error
                    GetEOF(Number;NumericVar) -> Number
                    GetEOF(&L;&L):L }

            kGETEOF:
                FuncPtr:=Ptr(ORD4(GetEOF(ORD(LongIntPtr(Params^[1])^),LongIntPtr(Params^[2])^)));


                {    GetFileInfo(Document;Type;Creator;DataLgLen;DataPyLen;ResLgLen;ResPyLen;
                                                                                                                            CrDate;MdDate;CrTime;MdTime)
                    GetFileInfo(String;String;String;LongInt;LongInt;LongInt;LongInt;
                                                                                                                            Date;Date;LongInt;LongInt)
                    GetFileInfo(&S;&S;&S;&L;&L;&L;&l;&D;&D;&L;&L) }

            kGetFileInfo:
                DoGetFileInfo;


        END; { CASE ORD(ProcNum) OF }
    END
    ELSE IF ProcNum=Init4DPackage THEN ShowDevToolDlg;
END; { FILES_PACKAGE }

END. { EXT4D_FILES_PACKAGE }